home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / Keystrok / KeyTst1U.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-05  |  4.2 KB  |  152 lines
  1. unit KeyTst1U;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Spin, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     btnDelphi: TButton;
  12.     edtGangScreen: TSpinEdit;
  13.     btnPrintScreen: TButton;
  14.     lblGangScreen: TLabel;
  15.     chkWholeScreen: TCheckBox;
  16.     imgClipBoard: TImage;
  17.     Bevel1: TBevel;
  18.     Edit1: TEdit;
  19.     btnCopyright: TButton;
  20.     procedure btnPrintScreenClick(Sender: TObject);
  21.     procedure chkWholeScreenClick(Sender: TObject);
  22.     procedure edtGangScreenChange(Sender: TObject);
  23.     procedure btnDelphiClick(Sender: TObject);
  24.     procedure btnCopyrightClick(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  30.  
  31. var
  32.   Form1: TForm1;
  33.  
  34. implementation
  35.  
  36. uses
  37.   KeysU, ClipBrd;
  38.  
  39. {$R *.DFM}
  40.  
  41. procedure TForm1.btnPrintScreenClick(Sender: TObject);
  42. begin
  43.   { Fake press of Print Screen }
  44.   SendKeys(Chr(vk_SnapShot));
  45.   { Get clipboard snapshot onto form's image component }
  46.   imgClipBoard.Picture.Assign(ClipBoard)
  47. end;
  48.  
  49. procedure TForm1.chkWholeScreenClick(Sender: TObject);
  50. begin
  51.   SnapShotWholeScreen := chkWholeScreen.Checked
  52. end;
  53.  
  54. procedure TForm1.edtGangScreenChange(Sender: TObject);
  55. begin
  56.   case edtGangScreen.Value of
  57.     1: lblGangScreen.Caption := 'Alt+DEVELOPERS';
  58.     2: lblGangScreen.Caption := 'Alt+TEAM';
  59.     3: lblGangScreen.Caption := 'Alt+VERSION (Delphi less than 3 only)';
  60.     4: lblGangScreen.Caption := 'Alt+AND (Delphi 1 only)';
  61.     5: lblGangScreen.Caption := 'Alt+QUALITY (Delphi 3 upwards only)';
  62.     6: lblGangScreen.Caption := 'Alt+CHUCK (Delphi 4 only)';
  63.   end
  64. end;
  65.  
  66. procedure TForm1.btnDelphiClick(Sender: TObject);
  67.  
  68.   function ScreenHas256ColoursOrMore: Boolean;
  69.   var
  70.     ScreenDC: HDC;
  71.   begin
  72.     ScreenDC := GetDC(HWnd_Desktop);
  73.     try
  74.       Result :=
  75.         GetDeviceCaps(ScreenDC, BitsPixel) *
  76.         GetDeviceCaps(ScreenDC, Planes) >= 8
  77.     finally
  78.       ReleaseDC(HWnd_Desktop, ScreenDC);
  79.     end;
  80.   end;
  81.  
  82. var
  83.   Wnd: HWnd;
  84. begin
  85.   Wnd := FindWindow('TAboutBox', 'About Delphi');
  86.   { Get rid of About box if it happens to be up so we know where we are }
  87.   if Wnd <> 0 then
  88.   begin
  89.     BringWindowToTop(Wnd);
  90.     SendKeys(Chr(vk_Escape));
  91.   end;
  92.   { Find Delphi's main window - note the Delphi }
  93.   { caption changes, so we'll use nil }
  94.   Wnd := FindWindow('TAppBuilder', nil);
  95.   if Wnd = 0 then
  96.     Exit;
  97.   { If Delphi is minimised, this statement may have no visible effect }
  98.   BringWindowToTop(Wnd);
  99.   { Delphi 1 has four About box gang screens, Delphi 2 has three }
  100.   { Delphi 3 has three and Delphi 4 has four. The fourth one }
  101.   { (Delphi 1 only) only works on >=256 colour screen drivers }
  102.  
  103.   SendKeys(Chr(vk_Menu)+'HA'); { Invoke the About box: Help | About }
  104.   PressKey(Char(vk_Menu)); { Hold down Alt key }
  105.   case edtGangScreen.Value of
  106.     1: SendKeys('DEVELOPERS');
  107.     2: SendKeys('TEAM');
  108.     3: SendKeys('VERSION');
  109.     4: if ScreenHas256ColoursOrMore then
  110.          SendKeys('AND')
  111.        else
  112.          MessageDlg(
  113.            'Alt+AND (Delphi 1 only) requires at least a 256-colour driver',
  114.            mtInformation, [mbOk], 0);
  115.     5: SendKeys('QUALITY');
  116.     6: SendKeys('CHUCK');
  117.   end;
  118.   ReleaseKey(Char(vk_Menu));  { Release Alt key }
  119. end;
  120.  
  121. procedure TForm1.btnCopyrightClick(Sender: TObject);
  122. begin
  123.   { The intention here is to enter the string: }
  124.   {   Copyright: ⌐ }
  125.   { into the edit control. This requires some planning }
  126.   { to get the mixed case, as well as the colon character }
  127.  
  128.   { Give focus to edit }
  129.   Edit1.SetFocus;
  130.   { Make sure Caps Lock is off }
  131.   if Odd(GetKeyState(vk_Capital)) then
  132.     SendKeys(Chr(vk_Capital));
  133.   { Hold down Shift key, press C, then release Shift }
  134.   PressKey(Chr(vk_Shift));
  135.   SendKeys('C');
  136.   ReleaseKey(Chr(vk_Shift));
  137.   { Press more keys (which will be lower case) }
  138.   SendKeys('OPYRIGHT');
  139.   { Hold down Shift key, press ;, then release Shift }
  140.   PressKey(Chr(vk_Shift));
  141.   SendKeys(#$BA);
  142.   ReleaseKey(Chr(vk_Shift));
  143.   { Send a space character }
  144.   SendKeys(Chr(vk_Space));
  145.   { Do Alt+0169 on number pad }
  146.   PressKey(Chr(vk_Menu));
  147.   SendKeys(Chr(vk_Insert) + Chr(vk_End) + Chr(vk_Right) + Chr(vk_Prior));
  148.   ReleaseKey(Chr(vk_Menu))
  149. end;
  150.  
  151. end.
  152.